home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PBLIB1
/
UNITS
/
PBEXEC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-03
|
7KB
|
252 lines
{SECTION ..PbEXEC }
UNIT PbEXEC;
INTERFACE
uses DOS, PbMISC, PbDATA, PbPARMS;
{
Description: Interface to PKZIP, TPC and Various Command.com functions
Author : Howard Richoux
Date : 8/2/90
Last revised: 12/15/93 hnr trivial re-formatting
2/18/94 hnr new libraries
Application : IBM PC and compatibles, Turbo Pascal 7.0
Status : Placed in the Public Domain by HNR Software 2/18/94
Published in: none
}
var ZIPError : integer;
Procedure CleanUpDir(WorkDir, FileMask : string);
{[FILE] Erases files based on a mask }
Procedure DisplayZIPError;
{[EXEC] PKZip interface }
Procedure DefaultCleanup(WorkDir : string);
{[FILE] Erases files *.BAK, *.MAP, temp*.*}
Procedure ParmCleanup(WorkDir : string);
{[FILE] Erases files based on param file}
Procedure ShowEraseStats;
{[FILE] shows count & bytes recovered}
Function UnZIPFile( op, ZIPName, DPath, fspec : string; qt : boolean) : boolean;
{[EXEC] Uses PKUnZip to de-archive files }
Function ZIPFile( op, ZIPName, fspec : string; qt : boolean) : boolean;
{[EXEC] Uses PKZip to archive files }
{SECTION .zImplementation }
IMPLEMENTATION
{-}
var ZIPDefaultop : string[16];
var ZIPFileName : string[50];
var ZIPDPath : string[50];
var EraseCount : Word; { files erased }
EraseSizeK : LongInt; { kilobytes released by erasing files }
{SECTION CleanUpDir }
Procedure CleanUpFile(WorkDir : string; SR : searchRec);
var l : longint;
begin
with SR do
begin
l := size div 512;
if (attr and 31) = 0 then
begin
if l = 0 then l := 1;
EraseSizeK := EraseSizeK + l;
writeln(' Removing: ',(AddBackSlash(WorkDir)+name),
' ',l div 2,'k');
EraseFile(AddBackSlash(WorkDir)+name);
inc(EraseCount);
end
else writeln(' ?? ',(AddBackSlash(WorkDir)+name),' ',l div 2,'k',
' attr: ',attr);
end;
end;
Procedure CleanUpDir(WorkDir, FileMask : string);
var Frec : SearchRec;
s : string[64];
begin
s := '';
findfirst(AddBackSlash(WorkDir)+FileMask, anyfile, Frec);
while doserror = 0 do
begin
CleanUpFile(WorkDir, Frec);
findnext(Frec);
end;
end;
{SECTION DefaultCleanup }
Procedure DefaultCleanup(WorkDir : string);
begin
CleanUpDir(WorkDir,'*.BAK');
CleanUpDir(WorkDir,'*.MAP');
CleanUpDir(WorkDir,'TEMP*.*');
end;
{SECTION DisplayZIPError }
Procedure DisplayZIPError;
begin
case ziperror of
0 : writeln('no error');
1..90 : writeln(ziperror:3,' Exec DOS error ');
98 : writeln(ziperror:3,' requested file not produced ');
99 : writeln(ziperror:3,' archive file not found');
end;
end;
{SECTION PbEXECInit }
Procedure PbEXECInit;
begin
ZIPError := 0;
ZIPDefaultop := '-n';
ZIPFileName := 'NOFILE.ZIP';
ZIPDPath := '';
EraseCount := 0;
EraseSizeK := 0;
end;
{SECTION ParmCleanup }
Procedure ParmCleanupItem(Workdir : string; Item : integer);
var itemstr : string[10];
parmname,maskname : string[40];
begin
str(item:1,itemstr);
parmname := 'CLEANUP' + itemstr;
if GetParmStr(parmname) <> '' then
begin
maskname := GetParmStr(parmname);
writeln(' Cleaning up ',maskname);
CleanUpDir(WorkDir,maskname);
end;
end;
Procedure ParmCleanup(WorkDir : string);
var i : integer;
begin
writeln('Cleaning up ',WorkDir);
for i := 1 to 10 do
ParmCleanUpItem(WorkDir,i);
end;
{SECTION ShowEraseStats }
Procedure ShowEraseStats;
{-Show statistics at the end of run}
begin
WriteLn('Files Erased: ', EraseCount,
' bytes used: ',EraseSizeK div 2,'k');
end;
{SECTION UnZIPFile }
Function UnZIPFile( op, ZIPName, DPath, fspec : string; qt : boolean) : boolean;
var s,zname : string;
i,j : integer;
begin
ZIPError := 0;
UnZIPFile := true;
s := 'PKUNZIP ';
if op <> '' then s := s + op
else s := s + ZIPDefaultop;
if ZIPName <> '' then zname := ZIPName
else zname := ZIPFileName;
if not FileExists(zname) then
begin
writeln('zname: [',zname,']');
UnZIPFile := false;
ZIPError := 99;
exit;
end;
s := s + ' ' + zname;
if DPath <> '' then s := s + ' ' + DPath
else s := s + ' ' + ZIPDPath;
s := s + ' ' + fspec;
if qt then s := s + ' >NUL ';
ZIPError := ExecuteCommand(s);
if ZIPError > 0 then
begin
writeln('PKUNZIP start failed ',ZIPError,' [',s,']');
UnZIPFile := false;
end
else begin
i := pos('*',fspec);
j := pos('?',fspec);
if (i = 0) and (j = 0) then
begin
if not FileExists(DPath + fspec) then
begin
UnZIPFile := false;
ZIPError := 98;
end;
end;
end;
end;
{SECTION ZIPFile }
Function ZIPFile( op, ZIPName, fspec : string; qt : boolean) : boolean;
var s,zname : string;
i,j : integer;
begin
ZIPError := 0;
ZIPFile := true;
s := 'PKZIP ';
if op <> '' then s := s + op
else s := s + ZIPDefaultop;
if ZIPName <> '' then zname := ZIPName
else zname := ZIPFileName;
s := s + ' ' + zname;
s := s + ' ' + fspec;
if qt then s := s + ' >NUL ';
ZIPError := ExecuteCommand(s);
if ZIPError > 0 then
begin
writeln('PKZIP start failed ',ZIPError,' [',s,']');
ZIPFile := false;
end
else begin
if not FileExists(ZIPname+'.ZIP') then
begin
ZIPFile := false;
ZIPError := 98;
end;
end;
end;
{SECTION zzInitialization }
begin {Initialization}
PbEXECInit;
end.